InterCD 2001 January/january_2001.iso/intercd/root/^4Developers/VB/visbasdb/VBDB/VBDB Code/VB6 Code/Class 6/Example6-8AD.frm

Visual Basic Form | 1999-09-17 | 10.6 KB | 360 lines

VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Begin VB.Form frmAuthors
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Authors"
   ClientHeight    =   3060
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3060
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdHelp
      Caption         =   "&Help"
      Height          =   375
      Left            =   3240
      TabIndex        =   14
      TabStop         =   0   'False
      Top             =   2640
      Width           =   1215
   End
   Begin VB.CommandButton cmdDone
      Caption         =   "Do&ne"
      Height          =   375
      Left            =   3240
      TabIndex        =   13
      TabStop         =   0   'False
      Top             =   2160
      Width           =   1215
   End
   Begin VB.CommandButton cmdDelete
      Caption         =   "&Delete"
      Height          =   375
      Left            =   1680
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   2160
      Width           =   1215
   End
   Begin VB.CommandButton cmdEdit
      Caption         =   "&Edit"
      Height          =   375
      Left            =   120
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   3240
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton cmdSave
      Caption         =   "&Save"
      Height          =   375
      Left            =   1680
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton cmdAddNew
      Caption         =   "&Add New"
      Height          =   375
      Left            =   120
      TabIndex        =   8
      TabStop         =   0   'False
      Top             =   2160
      Width           =   1215
   End
   Begin VB.CommandButton cmdNext
      Caption         =   "Next =>"
      Height          =   255
      Left            =   2520
      TabIndex        =   7
      TabStop         =   0   'False
      Top             =   1320
      Width           =   1215
   End
   Begin VB.CommandButton cmdPrevious
      Caption         =   "<= Previous"
      Height          =   255
      Left            =   1080
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   1320
      Width           =   1215
   End
   Begin VB.TextBox txtYearBorn
      DataField       =   "Year Born"
      DataSource      =   "datAuthors"
      Height          =   285
      Left            =   1200
      Locked          =   -1  'True
      MaxLength       =   4
      TabIndex        =   2
      Text            =   "Text"
      Top             =   840
      Width           =   1215
   End
   Begin VB.TextBox txtAuthor
      DataField       =   "Author"
      DataSource      =   "datAuthors"
      Height          =   285
      Left            =   1200
      Locked          =   -1  'True
      TabIndex        =   1
      Text            =   "Text2"
      Top             =   480
      Width           =   3375
   End
   Begin VB.TextBox txtAuthorID
      DataField       =   "Au_ID"
      DataSource      =   "datAuthors"
      Height          =   285
      Left            =   1200
      Locked          =   -1  'True
      TabIndex        =   3
      TabStop         =   0   'False
      Text            =   "Text1"
      Top             =   120
      Width           =   1215
   End
   Begin MSAdodcLib.Adodc datAuthors
      Height          =   330
      Left            =   2520
      Top             =   120
      Visible         =   0   'False
      Width           =   2055
      _ExtentX        =   3625
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   1
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=C:\VBDB\Working\Biblio.mdb"
      OLEDBString     =   "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=C:\VBDB\Working\Biblio.mdb"
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   "SELECT * FROM Authors ORDER BY Author"
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.Label Label3
      Caption         =   "Year Born"
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label2
      Caption         =   "Author Name"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   480
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Author ID"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
Attribute VB_Name = "frmAuthors"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
Private Const HELP_FINDER = &HB&
Private Sub ValidateData(AllOK As Boolean)
Dim Message As String
Dim InputYear As Integer, CurrentYear As Integer
AllOK = True
Message = ""
'Check for name
If Len(txtAuthor.Text) = 0 Then
  Message = "You must enter an Author Name." + vbCrLf
  txtAuthor.SetFocus
  AllOK = False
End If
'Check length and range on Year Born
InputYear = Val(txtYearBorn.Text)
CurrentYear = Val(Format(Now, "yyyy"))
If Len(txtYearBorn.Text) <> 0 Then
  If InputYear > CurrentYear Or InputYear < CurrentYear - 150 Then
    Message = Message + "Year Born must be between" & Str(CurrentYear - 150) & " and" & Str(CurrentYear) & "."
    txtYearBorn.SetFocus
    AllOK = False
  End If
End If
If Not (AllOK) Then
  MsgBox Message, vbOKOnly + vbInformation, "Validation Error"
End If
End Sub
Private Sub cmdAddNew_Click()
On Error GoTo HandleErrors
Call SetState("Add")
Exit Sub
HandleErrors:
Select Case MsgBox(Err.Description, vbCritical + vbAbortRetryIgnore, "Error Number" + Str(Err.Number) + " in " + Err.Source)
Case vbAbort
  Exit Sub
Case vbRetry
  Resume
Case vbIgnore
  Resume Next
End Select
End Sub
Private Sub cmdCancel_Click()
Call SetState("View")
End Sub
Private Sub cmdDelete_Click()
Dim Response As Integer
On Error GoTo HandleErrors
Response = MsgBox("Are you sure you want to delete this record?", vbYesNo + vbQuestion + vbDefaultButton2, "Delete")
If Response = vbNo Then
  Exit Sub
End If
Exit Sub
HandleErrors:
Select Case MsgBox(Err.Description, vbCritical + vbAbortRetryIgnore, "Error Number" + Str(Err.Number) + " in " + Err.Source)
Case vbAbort
  Exit Sub
Case vbRetry
  Resume
Case vbIgnore
  Resume Next
End Select
End Sub
Private Sub cmdEdit_Click()
Call SetState("Edit")
End Sub
Private Sub cmdHelp_Click()
Dim Rtn As Long
Rtn = WinHelp(frmAuthors.hwnd, App.HelpFile, HELP_FINDER, CLng(0))
End Sub
Private Sub cmdNext_Click()
datAuthors.Recordset.MoveNext
If datAuthors.Recordset.EOF Then
  Beep
  datAuthors.Recordset.MoveLast
End If
End Sub
Private Sub cmdPrevious_Click()
datAuthors.Recordset.MovePrevious
If datAuthors.Recordset.BOF Then
  Beep
  datAuthors.Recordset.MoveFirst
End If
End Sub
Private Sub cmdSave_Click()
Dim Valid As Boolean
Call ValidateData(Valid)
If Not (Valid) Then Exit Sub
On Error GoTo HandleErrors
MsgBox "Record saved.", vbOKOnly + vbInformation, "Save"
Call SetState("View")
Exit Sub
HandleErrors:
Select Case MsgBox(Err.Description, vbCritical + vbAbortRetryIgnore, "Error Number" + Str(Err.Number) + " in " + Err.Source)
Case vbAbort
  Exit Sub
Case vbRetry
  Resume
Case vbIgnore
  Resume Next
End Select
End Sub
Private Sub SetState(AppState As String)
Select Case AppState
Case "View"
  txtAuthorID.BackColor = vbWhite
  txtAuthor.Locked = True
  txtYearBorn.Locked = True
  cmdPrevious.Enabled = True
  cmdNext.Enabled = True
  cmdAddNew.Enabled = True
  cmdSave.Enabled = False
  cmdCancel.Enabled = False
  cmdEdit.Enabled = True
  cmdDelete.Enabled = True
  cmdDone.Enabled = True
  txtAuthor.SetFocus
Case "Add", "Edit"
  txtAuthorID.BackColor = vbRed
  txtAuthor.Locked = False
  txtYearBorn.Locked = False
  cmdPrevious.Enabled = False
  cmdNext.Enabled = False
  cmdAddNew.Enabled = False
  cmdSave.Enabled = True
  cmdCancel.Enabled = True
  cmdEdit.Enabled = False
  cmdDelete.Enabled = False
  cmdDone.Enabled = False
  txtAuthor.SetFocus
End Select
End Sub
Private Sub Form_Activate()
Call SetState("View")
End Sub
Private Sub txtAuthor_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
  txtYearBorn.SetFocus
  Exit Sub
End If
End Sub
Private Sub txtYearBorn_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
  txtAuthor.SetFocus
  Exit Sub
End If
If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = vbKeyBack Then
  Exit Sub
  Beep
  KeyAscii = 0
End If
End Sub